Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
' API Constants
' ==================================
Private Const PM_REMOVE = &H1
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private bCancel As Boolean
Private Const WM_MOUSEWHEEL = 522
Private Const SM_CYVSCROLL = 20
Private Type CurrentControlType
Name As String
Index As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Control properties
' ==================================
Public Enum BorderStyleEnum
[None]
[Fixed Single]
End Enum
Public Enum ScrollBehaviorEnum
[Normal]
[Middle]
[Reverse]
End Enum
Public Enum SensibilityEnum
[Highest]
[High]
[Medium]
[Low]
End Enum
Public Enum MarginEnum
[None] = 0
[5 pixels] = 5
[10 pixels] = 10
[15 pixels] = 15
[20 pixels] = 20
[25 pixels] = 25
[30 pixels] = 30
End Enum
'Default Property Values:
Const m_def_BorderStyle = 1
Const m_def_Enabled = True
Const m_def_ScrollBars = 3
Const m_def_Sensibility = 2
Const m_def_MarginV = 5
Const m_def_MarginH = 5
Const m_def_ScrollBehavior = 0
'Property Variables:
Dim m_BorderStyle As BorderStyleEnum
Dim m_Enabled As Boolean
Dim m_ScrollBars As ScrollBarConstants
Dim m_Sensibility As SensibilityEnum
Dim m_MarginV As MarginEnum
Dim m_MarginH As MarginEnum
Dim m_ScrollBehavior As ScrollBehaviorEnum
Private HPrevValue As Long
Private VPrevValue As Long
Private TempControl As Control
Private CurrCtrl As CurrentControlType
Private LastCtrl As CurrentControlType
'Initialize properties for a new user control
' ==================================
Private Sub UserControl_InitProperties()
m_BorderStyle = m_def_BorderStyle
m_Enabled = m_def_Enabled
m_ScrollBars = m_def_ScrollBars
m_Sensibility = m_def_Sensibility
m_MarginH = m_def_MarginH
m_MarginV = m_def_MarginV
m_ScrollBehavior = m_def_ScrollBehavior
End Sub
'Load properties from the PropBag
' ==================================
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
